home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / 4dostool / 4decomp.zip / 4DECOMP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-12  |  2KB  |  102 lines
  1. uses crt;
  2. var from,fto:file;
  3.  
  4. procedure getheader; { EB BE}
  5. var a:word;
  6. begin
  7.   writeln('source: getting header ...');
  8.   seek(from,0);
  9.   blockread(from,a,2);
  10.   if a<>$BEEB then begin
  11.     writeln('source: not a valid compressed .BTM file. halt.');
  12.     halt(1);
  13.   end;
  14. end;
  15.  
  16. var len,outp:word;
  17.  
  18. procedure getlength;
  19. begin
  20.   writeln('source: getting length of original batch-file ...');
  21.   seek(from,2);
  22.   blockread(from,len,2);
  23.   outp:=0;
  24. end;
  25.  
  26. var token:array[2..$1F] of byte;
  27.  
  28. procedure gettoken;
  29. begin
  30.   writeln('source: getting list of 32 most frequently used chars ...');
  31.   seek(from,4);
  32.   blockread(from,token,$1E);
  33. end;
  34.  
  35. var pos:word;
  36.     lower:boolean;
  37.     posval:byte;
  38.  
  39. function getnextnibble:byte;
  40. begin
  41.   if lower then begin
  42.     inc(pos);
  43.     blockread(from,posval,1);
  44.     getnextnibble:=posval shr 4;
  45.   end else begin
  46.     getnextnibble:=posval and $F;
  47.   end;
  48.   lower:=not lower;
  49. end;
  50.  
  51. procedure convert;
  52. var n,v:byte;
  53.     line:word;
  54. begin
  55.   line:=1;
  56.   pos:=$21;
  57.   lower:=true;
  58.   while not (outp=len) do begin
  59.     n:=getnextnibble;
  60.     case n of
  61.       0: begin
  62.        v:=getnextnibble;
  63.            v:=v+(getnextnibble shl 4);
  64.      end;
  65.       1: v:=token[$10+getnextnibble];
  66.       else v:=token[n];
  67.     end;
  68.     blockwrite(fto,v,1);
  69.     if v=$0d then begin
  70.       v:=$0a;
  71.       blockwrite(fto,v,1);
  72.       writeln('converted line ',line);
  73.       inc(line);
  74.       gotoxy(1,wherey-1);
  75.     end;
  76.     inc(outp);
  77.   end;
  78.   writeln;
  79. end;
  80.  
  81. begin
  82.   writeln('4DECOMP - (c) 1993 by Akisoft, Vienna');
  83.   writeln('decompresses 4DOS 5.0 .BTM-files compressed with BATCOMP');
  84.   writeln;
  85.   if paramcount<2 then begin
  86.     writeln('usage: DECOMP file1 file2');
  87.     halt;
  88.   end;
  89.   assign(from,paramstr(1));
  90.   assign(fto,paramstr(2));
  91.   reset(from,1);
  92.   rewrite(fto,1);
  93.   getheader;
  94.   getlength;
  95.   gettoken;
  96.   convert;
  97.   writeln('closing files ...');
  98.   close(from);
  99.   close(fto);
  100.   writeln('finished!');
  101. end.
  102.